home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt86oct.arc / ALLOC.ARC / ALLOC1.MOD < prev    next >
Text File  |  1985-07-12  |  4KB  |  155 lines
  1. IMPLEMENTATION MODULE Alloc1;
  2.  
  3. (* A simple storage allocator that uses the first-fit strategy.  
  4.    Copyright 1986 by Jonathan Amsterdam.  All Rights Reserved. *)
  5.  
  6. FROM SYSTEM IMPORT WORD, ADDRESS, TSIZE;
  7. FROM MachineSpecific IMPORT getHeapBottom, getHeapTop, bytesPerWord,
  8.     address, cardinal, addrLessThan, writeAddress;
  9. FROM MyTerminal IMPORT fatal;
  10.  
  11. CONST maxIndex = 32767;
  12.  
  13. TYPE blockPtr = POINTER TO block;
  14.      block = RECORD
  15.          size:CARDINAL;  (* not including header *)
  16.          CASE BOOLEAN OF
  17.             TRUE: nextBlock: blockPtr;
  18.          |  FALSE: contents:ARRAY[0..maxIndex] OF WORD;
  19.          END;
  20.          END;
  21.  
  22. VAR heapBottom, heapTop:ADDRESS;
  23.     freeList:blockPtr;
  24.     blockHeaderSize, minBlockSize:CARDINAL;
  25.  
  26. PROCEDURE init;
  27. VAR a:ADDRESS;
  28. BEGIN
  29.     heapBottom := getHeapBottom();
  30.     heapTop := getHeapTop();
  31.     freeList := blockPtr(heapBottom);
  32.     freeList^.size := 
  33.      (cardinal(heapTop - heapBottom) DIV bytesPerWord) - blockHeaderSize;
  34.     freeList^.nextBlock := NIL;
  35.     blockHeaderSize := TSIZE(CARDINAL);
  36.     minBlockSize := TSIZE(blockPtr) + blockHeaderSize;
  37. END init;
  38.  
  39. PROCEDURE blockSize(blockp:blockPtr):CARDINAL;
  40. BEGIN
  41.     RETURN blockp^.size;
  42. END blockSize;
  43.  
  44. PROCEDURE getWord(blockp:blockPtr; n:CARDINAL):WORD;
  45. BEGIN
  46.     IF n < blockp^.size THEN
  47.     RETURN blockp^.contents[n];
  48.     ELSE
  49.     fatal('getWord: out of bounds');
  50.     END;
  51. END getWord;
  52.  
  53. PROCEDURE setWord(blockp:blockPtr; n:CARDINAL; w:WORD);
  54. BEGIN
  55.     IF n < blockp^.size THEN
  56.     blockp^.contents[n] := w;
  57.     ELSE
  58.     fatal('setWord: out of bounds');
  59.     END;
  60. END setWord;
  61.  
  62. PROCEDURE allocate(nWords:CARDINAL):blockPtr;
  63. VAR currBlock, prevBlock:blockPtr;
  64. BEGIN
  65.     currBlock := freeList;
  66.     prevBlock := NIL;
  67.     WHILE currBlock <> NIL DO
  68.     IF nWords + minBlockSize < currBlock^.size THEN
  69.         (* split the block into two, returning the 2nd part *)
  70.         DEC(currBlock^.size, nWords+blockHeaderSize);
  71.         INC(currBlock, bytesPerWord*(blockHeaderSize + currBlock^.size)); 
  72.         currBlock^.size := nWords;
  73.         RETURN currBlock;
  74.     ELSIF nWords <= currBlock^.size THEN (* return the whole block *)
  75.         link(prevBlock, currBlock^.nextBlock);
  76.         RETURN currBlock;
  77.     END;
  78.     prevBlock := currBlock;
  79.     currBlock := currBlock^.nextBlock;
  80.     END;
  81.     RETURN NIL;
  82. END allocate;
  83.  
  84. PROCEDURE free(VAR freeBlock:blockPtr);
  85. VAR currBlock, prevBlock:blockPtr; 
  86. BEGIN
  87.     IF addrBetween(heapBottom, freeBlock, heapTop) THEN
  88.     currBlock := freeList;
  89.     prevBlock := NIL;
  90.     WHILE (currBlock <> NIL) AND addrLessThan(currBlock, freeBlock) DO
  91.         prevBlock := currBlock;
  92.         currBlock := currBlock^.nextBlock;
  93.     END;
  94.     IF currBlock = NIL THEN
  95.         freeBlock^.nextBlock := NIL;
  96.         link(prevBlock, freeBlock);
  97.     ELSE  (* freeBlock belongs just before currBlock *)
  98.         freeBlock^.nextBlock := currBlock;
  99.         link(prevBlock, freeBlock);
  100.     END;
  101.     tryToMerge(prevBlock, freeBlock, currBlock);
  102.     freeBlock := NIL;
  103.     END;
  104. END free;
  105.  
  106. PROCEDURE tryToMerge(lowBlock, middleBlock, highBlock:blockPtr);
  107. BEGIN
  108.     IF adjacent(middleBlock, highBlock) THEN
  109.     merge(middleBlock, highBlock);
  110.     END;
  111.     IF adjacent(lowBlock, middleBlock) THEN
  112.     merge(lowBlock, middleBlock);
  113.     END;
  114. END tryToMerge;
  115.  
  116. PROCEDURE adjacent(lowerBlock, higherBlock:blockPtr):BOOLEAN;
  117. BEGIN
  118.   RETURN 
  119.     (lowerBlock <> NIL) AND
  120.     (higherBlock <> NIL) AND
  121.     (lowerBlock + address(bytesPerWord*(lowerBlock^.size + blockHeaderSize)) = 
  122.        higherBlock);
  123. END adjacent;
  124.     
  125. PROCEDURE merge(lowerBlock, higherBlock:blockPtr);
  126. BEGIN
  127.     INC(lowerBlock^.size, higherBlock^.size + blockHeaderSize);
  128.     lowerBlock^.nextBlock := higherBlock^.nextBlock;
  129. END merge;
  130.     
  131. PROCEDURE link(prevBlock, linkBlock:blockPtr);
  132. BEGIN
  133.     IF prevBlock = NIL THEN
  134.     freeList := linkBlock;
  135.     ELSE
  136.     prevBlock^.nextBlock := linkBlock;
  137.     END;
  138. END link;
  139.  
  140. PROCEDURE addrBetween(low, middle, high:ADDRESS):BOOLEAN;
  141. BEGIN
  142.     RETURN (addrLessThan(low, middle) OR (low = middle)) AND
  143.        (addrLessThan(middle, high) OR (middle = high));
  144. END addrBetween;
  145.  
  146. PROCEDURE getFreeList():blockPtr;
  147. (* for debugging only *)
  148. BEGIN
  149.     RETURN freeList;
  150. END getFreeList;
  151.  
  152. BEGIN
  153.     init;
  154. END Alloc1.
  155. reeList(